Imports System.Runtime.InteropServices

Public Class MessageFilter : Implements IMessageFilter

    Public Shared Sub Register()
        Dim objNewMessageFilter As IMessageFilter = New MessageFilter

        Dim objOldMessageFilter As IMessageFilter = Nothing

        CoRegisterMessageFilter(objNewMessageFilter, objOldMessageFilter)
    End Sub

    Public Shared Sub Revoke()
        Dim objOldMessageFilter As IMessageFilter = Nothing

        CoRegisterMessageFilter(Nothing, objOldMessageFilter)
    End Sub

    Public Function HandleInComingCall(ByVal dwCallType As Integer, ByVal hTaskCaller As System.IntPtr, ByVal dwTickCount As Integer, ByVal lpInterfaceInfo As System.IntPtr) As Integer Implements IMessageFilter.HandleInComingCall
        Trace.WriteLineIf(AppTrace, "MessageFilter.HandleInComingCall")

        Return 0 'SERVERCALL_ISHANDLED
    End Function

    Public Function MessagePending(ByVal hTaskCallee As System.IntPtr, ByVal dwTickCount As Integer, ByVal dwPendingType As Integer) As Integer Implements IMessageFilter.MessagePending
        Trace.WriteLineIf(AppTrace, "MessageFilter.MessagePending")

        Return 2 'PENDINGMSG_WAITDEFPROCESS 
    End Function

    Public Function RetryRejectedCall(ByVal hTaskCallee As System.IntPtr, ByVal dwTickCount As Integer, ByVal dwRejectType As Integer) As Integer Implements IMessageFilter.RetryRejectedCall
        Trace.WriteLineIf(AppTrace, "MessageFilter.RetryRejectedCall")

        If (dwRejectType = 2) Then  'SERVERCALL_RETRYLATER
            Return 99 'retry immediately if return >=0 & <100
        End If

        Return -1 'Cancel Call
    End Function

    <DllImport("Ole32.dll")> _
    Private Shared Function CoRegisterMessageFilter(ByVal newfilter As IMessageFilter, ByVal oldfilter As IMessageFilter) As Int32
    End Function
End Class

<ComImport() _
, Guid("00000016-0000-0000-C000-000000000046") _
, InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
Interface IMessageFilter
    <PreserveSig()> _
    Function HandleInComingCall( _
       ByVal dwCallType As Int32, _
       ByVal hTaskCaller As IntPtr, _
       ByVal dwTickCount As Int32, _
       ByVal lpInterfaceInfo As IntPtr) _
       As Int32

    <PreserveSig()> _
    Function RetryRejectedCall( _
       ByVal hTaskCallee As IntPtr, _
       ByVal dwTickCount As Int32, _
       ByVal dwRejectType As Int32) _
       As Int32

    <PreserveSig()> _
    Function MessagePending( _
       ByVal hTaskCallee As IntPtr, _
       ByVal dwTickCount As Int32, _
       ByVal dwPendingType As Int32) _
       As Int32
End Interface
